package Net::Coro::EV::POP3;
use common::sense;
our $VERSION = 0.03;

use EV;
use Net::SSLeay;

use Net::Coro::EV::Connect::Socket;
*BINDIP = \$Net::Coro::EV::Connect::Socket::BINDIP;

our $TIMEOUT = 10;
our $TRACE = 0;

use constant {	
	RT_SINGLE => 0,
	RT_MULTY => 1,
};
sub new {
	my ($class, $socket) = @_;
	$class = ref($class) || $class;	

	my $this = {};
	$this->{_TIMEOUT} = $TIMEOUT;

	
	$socket = new Net::Coro::EV::Connect::Socket if !$socket;
	$this->{_SOCKET} = $socket;

	bless $this, $class;
	return $this;
}
sub socket {$_[0]->{_SOCKET}->child}

sub new_tls {
	my ($this) = @_;
	
	# init tls/ssl context
	if (!$this->{_TLS_CTX}) {
		Net::SSLeay::load_error_strings();
		Net::SSLeay::SSLeay_add_ssl_algorithms();
		Net::SSLeay::randomize();
		
		$this->{_TLS_CTX} = Net::SSLeay::CTX_new();
		Net::SSLeay::CTX_set_options ($this->{_TLS_CTX}, Net::SSLeay::OP_ALL());
	}
	
	# init tls/ssl session
	my $tls = $this->{_TLS} = Net::SSLeay::new ($this->{_TLS_CTX});
	Net::SSLeay::set_connect_state ($tls);
	Net::SSLeay::CTX_set_mode ($tls, 1|2); #  need for non-blocking ( MODE_ENABLE_PARTIAL_WRITE | MODE_ACCEPT_MOVING_WRITE_BUFFER)
	my $rbio = $this->{_TLS_RBIO} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
	my $wbio = $this->{_TLS_WBIO} = Net::SSLeay::BIO_new (Net::SSLeay::BIO_s_mem ());
	Net::SSLeay::set_bio ($tls, $rbio, $wbio);
}

sub tls_request {
	my ($this) = @_;
	
	if (!$this->{_TLS_WRITED}) {
		my $request = $this->{_REQUEST};
		my $tmp;
		while (($tmp = Net::SSLeay::write ($this->{_TLS}, $request)) > 0) {
			substr $request, 0, $tmp, '';
		}
		# if $tmp <=0 (in fact -1) than assume handshake stage (this is not error)
		
		$this->{_TLS_WRITED} = 1 if !length($request);
	}
	$this->{_TLS_REQUEST} = Net::SSLeay::BIO_read ($this->{_TLS_WBIO});
}


sub ssl {
	my ($this) =@_;
	$this->{_REQUEST} = "";
	$this->new_tls();
	$this->tls_request();
}

sub connect {
	die(__PACKAGE__." connect: arguments count less then 2") if $#_ < 2;
	my ($this, $host, $cb, @prm) = @_;
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;
	
	$this->{_RESPONSE} = "";
	undef $this->{_TLS_WRITED};
	$this->{_RESPONSE_TYPE} = RT_SINGLE;
	
	my $port = 110;
	$port = 995 if (defined $this->{_TLS});
	$this->{_SOCKET}->connect($host, $port, $this);
}

sub onconnect {
	my ($this, $wio, $wtm, $serv_ip, $serv_port) = @_;
	return $this->err($this->{_SOCKET}->errm, $this->{_SOCKET}->errc) if !$wio;
	
	$this->{_WIO} = $wio;
	$this->{_WTM} = $wtm;
	
	$this->{_WIO}->data($this);
	
	if (defined $this->{_TLS}) {
		$this->{_WIO}->events (EV::WRITE);
	} else {
		$this->{_WIO}->events (EV::READ);
	}
}


sub mcmd {
	my $this = shift;
	$this->{_MCMD} = 1;
	$this->cmd(@_);
}

sub cmd {
	die(__PACKAGE__." cmd: arguments count less then 2. check command and callback.") if $#_ < 2;
	my ($this, $cmd, $cb, @prm) = @_;
	print "TRACE $this->{_ID}, POP3 command - $cmd\n" if $TRACE;
	
	$this->{_CB} = $cb;
	$this->{_PRM} = \@prm;
	return $this->err("no connection established", 11)  if !$this->{_WIO};
	
	$this->{_RESPONSE_TYPE} = RT_SINGLE;
	if (!!$this->{_MCMD}) {
		$this->{_RESPONSE_TYPE} = RT_MULTY;
		undef $this->{_MCMD};
	}
	
	$this->{_RESPONSE} = "";
	undef $this->{_TLS_WRITED};
	undef $this->{_CHECK_CODE};
	$this->{_REQUEST} = $cmd."\r\n";
	$this->tls_request() if (defined $this->{_TLS});
	
	$this->{_WIO}->events (EV::WRITE);
	$this->{_WIO}->start();
	$this->{_WTM}->start();
	
	$this->{_WTM}->set($this->{_TIMEOUT}, $this->{_TIMEOUT});
}


sub onwrite {
	my ($this) = @_;
	
	my $request ;
	if (defined $this->{_TLS}) {
		$request = $this->{_TLS_REQUEST} ;
	} else {
		$request = $this->{_REQUEST};
	}

	utf8::downgrade($request);
	return $request;
}

sub onwritten {
	my ($this, $w) = @_;
	$w->events (EV::READ);
}

sub onread {
	my ($this, $response) = @_;	# plain text
	
	# check if ssl
	if (defined $this->{_TLS}) {
		Net::SSLeay::BIO_write ($this->{_TLS_RBIO}, $response);
		$response = undef;
		my $tmp_resp;
		while (!!($tmp_resp = Net::SSLeay::read ($this->{_TLS}))) {
			### check length if 0 - error or end (shoudl not ever happen)
			$response .= $tmp_resp;
		}

		# check if handshake stage
		if (!$response) {
			$this->{_WIO}->events (EV::WRITE) if $this->tls_request(); # else leave EV::READ			
			return;
		}
	}
	
	
	$this->{_RESPONSE} .= $response;
	
	if (!$this->{_CHECK_CODE} and $this->{_RESPONSE_TYPE} == RT_MULTY) {
		$this->{_CHECK_CODE} = 1;
		my $sign = substr $this->{_RESPONSE}, 0, 1;
		$this->{_RESPONSE_TYPE} = RT_SINGLE if ($sign eq '-');
	}

	my ($tail, $code, $msg, $data);
	if ($this->{_RESPONSE_TYPE} == RT_MULTY) {		
		$tail = substr $this->{_RESPONSE}, -5;
		return if ($tail ne "\r\n.\r\n");
		($code, $msg, $data) = $this->{_RESPONSE} =~ /^([\+\-]\w+)\s+(.*?)\r\n(.*)\r\n\.\r\n$/s;
	} else {
		$tail = substr $this->{_RESPONSE}, -2;
		return if ($tail ne "\r\n");
		$data = $this->{_RESPONSE};
		$data =~ s/\s*$//s;
		($code, $msg) = $data =~ /^([\+\-]\w+)\s+(.*)$/s;
	}
	
	$this->callback($code, $msg, $data);
}



####### COMMON ARCHITECTURAL METHODS AND EVENT HANDLERS #######
sub callback {
	my ($this, $code, $msg, $data) = @_;
	$this->{_WIO}->stop();
	$this->{_WTM}->stop();
	
	# call back
	undef $this->{_ERRM};
	undef $this->{_ERRC};
	delete $this->{_ERR};
	$this->{_WTM}->stop();
	
	(delete $this->{_CB})->($this, 
		$code, $msg, $data,
		@{delete $this->{_PRM}}
	);
}


sub err {
	my ($this, $msg, $code) = @_;
	$this->{_ERRM} = $msg;
	$this->{_ERRC} = $code;

	# close all
	$this->close;
	
	# send error
	my @prm = @{delete $this->{_PRM}};
	my $cb = delete $this->{_CB};
		
	my $errcb = delete $this->{_ERR};
	if (!$errcb) {
		$cb->($this,undef,$msg,$code,$cb, @prm);
	} 
	else {
		$errcb->($this,$msg,$code,$cb,$errcb, @prm);
	}
}



sub onclose {
	my ($this) = @_;
	# make desigion what to do
	# default is to send error
	$this->err("connectnion closed by peer",6);
}

sub onbreak {
	my ($this, $msg, $code) = @_;
	# make desigion what to do
	# default is to send error
	$this->err($msg, 2);
}

sub close {
	my ($this) =@_;
	Net::SSLeay::free (delete $this->{_TLS}) if (defined $this->{_TLS});
	
	my $tm = delete $this->{_WTM};
	$tm->stop() if defined $tm;
	
	my $w = delete $this->{_WIO};
	if (defined $w) {
		$w->stop();
		my $fh = $w->fh;
		shutdown($fh, 2);
		CORE::close($fh);
	}
}

sub stop {
	my ($this) = @_;
	$this->{_SOCKET}->stop();
	$this->close();
	delete $this->{_CB};
	delete $this->{_ERR};
	delete $this->{_PRM};
}


sub error {
	my ($this, $cberr) = @_;
	$this->{_ERR} = $cberr;
}

### PUBLIC METHODS TO SET/GET REQUEST PROPIRTIES ######
sub timeout {
	my ($this, $val) = @_;	
	if (defined $val) {
		$this->{_TIMEOUT} = $val;
		$this->{_SOCKET}->timeout($val);
	}
	return $this->{_TIMEOUT};
}
sub timeout_conn {
	my ($this, $val) = @_;
	$this->{_SOCKET}->timeout($val);
}

sub errc {$_[0]->{_ERRC}}
sub errm {$_[0]->{_ERRM}}

sub id {
	my ($this, $id) = @_;
	if (defined $id) {
		$this->{_ID} = $id;
		$this->{_SOCKET}->id($id);
	}
	$this->{_ID};
}
sub bindip {$_[0]->{_SOCKET}->bindip($_[1])}


1;